#'###########################################
#'                                          #
#'  ------------------------------------    #
#'  |     COIN     __                  |    #
#'  |            >(' )                 |    #
#'  |              )/                  |    #
#'  |             /  `----/            |    #
#'  |             \  ~=- /             |    #
#'  |   ~^~^~^~^~^~^~^~^~^~^~^~^~^~^   |    #
#'  ------------------------------------    #
#'                                          #
#'###########################################

ErrorDensities <- setClass("ErrorDensities", representation(
        longitude="density",
        latitude="density"))

getDensityByLC <- function(locClass, data){
    densities <- new("ErrorDensities")
    tmp <- data[LC == locClass]
    densities@longitude <- density(tmp$diffLong, from=0)
    densities@latitude <- density(tmp$diffLat, from=0)
    return (densities)
}

getErrorDensities <- function(data){
    densities <- lapply(levels(data$LC), getDensityByLC, data=data)
    names(densities) <- levels(data$LC)
    return (densities)
}


generateErrors <- function(densities, npoints) {
    long <- sample(c(-densities@longitude$x, densities@longitude$x), size=npoints, replace=TRUE, prob=rep(densities@longitude$y, 2))
    lat <- sample(c(-densities@latitude$x, densities@latitude$x), size=npoints, replace=TRUE, prob=rep(densities@latitude$y, 2))
    return (cbind(x=long, y=lat))
}

generatePointsInRadius <- function(npoints, radius) {
    t <- 2 * pi * runif(npoints)
    r <- runif(npoints, 0L, radius) + runif(npoints, 0L, radius)
    idx <- which(r > radius)
    r[idx] <- 2*radius - r[idx]
    return (cbind(x=r*cos(t), y=r*sin(t)))
}


generatePointsInRect <- function(npoints, width, height=NULL) {
    if (is.null(height)){
        height <- width
    }
    #' Center on 0
    x <- runif(npoints, -(width / 2), (width / 2))
    y <- runif(npoints, -(height / 2), (height / 2))
    return (cbind(x, y)) 
}


generateHRCompareDataFromTracks <- function(tracks, errors, npoints,
                                            reps=1L, locsClasses,
                                            locsWeights=NULL, rawErrors=FALSE) {
     setkey(tracks, deployment)
     depl <- levels(tracks$deployment)
     res <- vector("list", length(depl))
     for (i in seq_along(depl)) {
         data <- tracks[depl[i]]
         n <- npoints[i]
         res[[i]] <- generateHRCompareData(cbind(data$longitude, data$latitude), errors, n, reps, locsClasses, locsWeights, depl[i], rawErrors)
     }
     
     res <- do.call(c, res)
     return(res)
}

generateHRCompareData <- function(points, errors, npoints, reps=1L, locsClasses, locsWeights=NULL, deployment=NULL, rawErrors=FALSE){

    npts <- length(npoints)
    if (npts > 1) {
        if (reps > 1) {
            npoints <- rep(npoints, reps)
        }
        n <- length(npoints)
    } else {
        n <- reps
    }
    
    res <- lapply(1:n, applyErrors, points, errors, npoints, locsClasses, locsWeights, deployment, rawErrors)
    
    return (res)
}

applyErrors <- function(iteration, points, errors, npoints, locsClasses, locsWeights=NULL, deployment=NULL, rawErrors=FALSE){
    
    #' If no weights are provided or lengths differ,
    #' all LC get an equal number of points
    if (is.null(locsWeights) ||
        length(locsWeights) != length(locsClasses)){
        locsWeights <- rep(1/length(locsClasses), length(locsClasses))
    }
    
    
    #' if npoints is a vector, get the right n. Otherwise use npoints for the sample.
    if (length(npoints) > 1) {
        n <- npoints[iteration]
    } else {
        n <- npoints
    }

    #' Get the number of points that will be assigned a specific
    #' error according to the specified weights
    nerr <- round(locsWeights * n)
    if(sum(nerr) != n) {
        n <- sum(nerr)
    }
    
    #' Generate a sub sample of points
    pIdx <- sample(1:nrow(points), n)
    subPoints <- points[pIdx, ]
    
    #' Generate a subsample of errors for each LC
    tmp <- vector("list", length(locsClasses))
    for (i in seq(along=locsClasses)) {
        tmpErr <- errors[[locsClasses[i]]]
        eIdx <- sample(1:nrow(tmpErr), nerr[i])
        tmp[[i]] <- tmpErr[eIdx, ]
    }
    subErrors <- do.call(rbind, tmp)
    
    genErrors <- subPoints + subErrors
    
    if(is.null(deployment)) {
        deployment <- iteration
    }
    if (!rawErrors) {
      return (list(ref=SpatialPoints(points), compared=SpatialPoints(genErrors), deployment=deployment))
    } else {
        names(tmp) <- locsClasses
        return (list(ref=SpatialPoints(points), compared=SpatialPoints(genErrors), deployment=deployment, errors=tmp))
    } 
}




#'#
#'# Genere des erreurs pour les traces mobile pour des classes de localisation donnees
#'# a partir des donnees originales
#'# 
generateTracksErrorsbyLC <- function(errors, refData, generatedErrors, locsClasses) { 
    
    filteredErrors <- errors[LC %in% locsClasses]
    setkey(filteredErrors, LC)
    nPoints <- filteredErrors[, .N, by=deployment]$N
    locsWeights <- filteredErrors[, .N/length(filteredErrors$argLong), by=LC]$V1
    
    
    #' Data generated from gps tracks
    generatedTracks <- generateHRCompareDataFromTracks(refData, generatedErrors,
        npoints=nPoints,
        locsClasses=locsClasses,
        locsWeights=locsWeights, rawErrors=TRUE)
    names(generatedTracks) <- levels(refData$deployment)
    
    return (generatedTracks)
}

#'#
#'# Recupere les informations sur les erreur generees pour faire des statistiques dessus
#'# 
getGeneratedErrorsFromTracks <- function (generatedTracks, locsClasses) {
    
    generatedErrors <- lapply(generatedTracks, function(x){return(x$errors)})
    
    tmpres <- vector("list", length(locsClasses))
    for (i in seq_along(locsClasses)) {
        tmperr <- do.call(rbind, lapply(generatedErrors, function(x){return(x[[locsClasses[i]]])}))
        tmp <- data.frame(tmperr, LC=locsClasses[i], stringsAsFactors=FALSE)
        tmpres[[i]] <- tmp
    }
    res <- rbindlist(tmpres)
    res[, LC := factor(LC, levels=locsClasses)]
    res[, distance := sqrt(x^2 + y^2)]
    
    return (res)
}
